Games of Daze/Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso/x2ftp/msdos/source/demostu2/tunnel2.pas

Pascal/Delphi Source File | 1994-12-15 | 5.0 KB | 277 lines

PROGRAM Tunnel2;
{
  Tunnel2
  - by Bjarke Viksφe
  aug 1994

  A better version.
  Skipped the screen mode $13. Screen mode is instead 320x200x16.
  Plots are made to a buffer. It is made 256 bytes wide, so we can
  address (x,y) fast.
  When dots are drawn, buffer is dumped to display screen. Still use
  triple buffering though.
}

{$A+,B-,G+,E+,I+,N-,X+}


USES
    DEMOINIT;

{$DEFINE DEBUG}

CONST
    NUMBER_CIRCLES = 64;
    NUMBER_DOTS = 64;
    NUMBER_ANIMS = 8;

TYPE
    pCoordBuffer = ^CoordBuffer;
    CoordBuffer = array[0..(NUMBER_CIRCLES*NUMBER_DOTS*2)-1] of integer;

VAR
    sinustabel : array[0..639] of integer;
    v1 : word;
    cos1,sin1 : integer;

    pos : word;
    xpos, ypos : word;

    coords : array[0..NUMBER_ANIMS-1] of pCoordBuffer;
    buffer : pScreen;


CONST
    display1 : word = $0000;
    display2 : word = $4000;
    display3 : word = $8000;


(*------------------------------------------------*)

procedure SetupSinus;
var
    i : integer;
    v, vadd : real;
begin
    v:=0.0;
    vadd:=(2.0*pi/512.0);
    for i:=0 to 639 do begin
        sinustabel[i]:=round(sin(v)*32767);
        v:=v+vadd;
    end;
end;

procedure SetupCoords;
{Precalc circle coords.
 For each anim the start-rotation angle is changed a bit, so it looks
 like the whole lot turns around}
var
    h,i,j,k : integer;
    v1 : word;
    cos1,sin1 : integer;
    x : integer;
    x1,y1 : longint;
begin
    for i:=0 to NUMBER_ANIMS-1 do New(coords[i]);

    for h:=0 to NUMBER_ANIMS-1 do begin
        k:=0;
        x:=80;
        for i:=1 to NUMBER_CIRCLES do begin
            {set start angle}
            v1:=h;
            for j:=1 to NUMBER_DOTS do begin
                sin1:=sinustabel[v1 AND 511];
                cos1:=sinustabel[(v1 AND 511)+128];
                {calc dot coordinate}
                x1:=LongMul(x,sin1) DIV 32768;
                y1:=LongMul(x,cos1) DIV 32768;
                {perspective calc... x1 is lower because of screen aspect}
                x1:=LongDiv(x1 SHL 8,700);
                y1:=LongDiv(y1 SHL 8,800);
                coords[h]^[k]:=y1;
                coords[h]^[k+1]:=x1;
                inc(k,2);
                inc(v1,512 DIV NUMBER_DOTS);
            end;
            inc(x,8);
        end;
    end;
end;


(*------------------------------------------------*)

procedure InitDemo;
var
    p : pointer;
    i : integer;
begin
    ClearWholeScreen;
    SetupSinus;
    SetupCoords;

    {allocate memory for buffer. Offset MUST be $0000 though!!!}
    New(buffer);
    while Ofs(buffer^)<>0 do begin
        Dispose(buffer);
        GetMem(p,1); {does this really work? Think not!}
        New(buffer);
    end;
    FillChar(buffer^,SizeOf(ScreenType),#0);

    pos:=0;
    xpos:=0; ypos:=0;
end;

procedure UninitDemo;
var
    i : integer;
begin
    Dispose(buffer);
    for i:=0 to NUMBER_ANIMS-1 do Dispose(coords[i]);
end;


(*------------------------------------------------*)

procedure SwapDisplay;
var
    temp : word;
begin
    temp:=display3;
    display3:=display2;
    display2:=display1;
    display1:=temp;
    SetAddress(Ptr(SEGA000,display2));
end;

procedure MoveBuffer; assembler;
{Move buffer to display memory}
asm
    push    ds

    mov    es,SEGA000
    mov    di,display1
    lds    si,buffer
    DB LONG; xor ax,ax
    mov    bx,-4
    mov    dx,199            {ysize}
    cld
@yloop:
    mov    cl,40/4
@xloop:
    movsw                        {move buffer word to video memory}
    movsw
    DB LONG; mov [si+bx],ax        {clear the buffer again}
    dec    cl
    jnz    @xloop

    add    si,256-40
    dec    dx
    jnz    @yloop

    pop    ds
end;


(*------------------------------------------------*)

procedure DrawRingWithCut(x,y : integer; coords : pointer); assembler;
asm
    push    ds
    push    bp

    les    ax,buffer
    lds    si,coords
    mov    dx,y
    mov    bp,x
    mov    bl,NUMBER_DOTS
    mov    bh,$80
    cld
@loop:
    lodsw                    {get y}
    add    ax,dx
    mov    cx,ax
    lodsw                    {get x}
    add    ax,bp
    cmp    ax,320        {dots outside xpos [0..319] are not drawn}
    jae    @none
    cmp    cx,200        {dots outside ypos [0..199] are not drawn}
    jae    @none
    mov    ch,al            {calc offset address}
    shr    ax,3
    mov    ah,cl
    mov    di,ax
    mov    al,bh            {calc bit pos}
    mov    cl,ch
    ror    al,cl
    or        [es:di],al
@none:
    dec    bl
    jnz    @loop

    pop    bp
    pop    ds
end;


(*------------------------------------------------*)

procedure RunOnce;
var
    x,y,z : integer;
    i,j : integer;
    tempx, tempy    : word;
begin
    SwapDisplay;
{$IFNDEF DEBUG}
    while retraces=0 do ;
    retraces:=0;
{$ELSE}
    i:=total_retraces;
    while i=total_retraces do ;
    SetRGB(0,20,0,0);
{$ENDIF}

    tempx:=xpos; tempy:=ypos;
    z:=400;

    j:=0;
    for i:=1 to NUMBER_CIRCLES do begin
        {find circles' position}
        x := 160+LongDiv(sinustabel[tempx AND 511],z);
        y := 100+LongDiv(sinustabel[tempy AND 511],z);
        DrawRingWithCut(x,y,@coords[pos]^[j]);
        {move next circle in sinus-pos}
        inc(tempx,6); inc(tempy,5);
        {next circle is a bit longer back}
        inc(z,25);
        inc(j,NUMBER_DOTS*2);
    end;
    MoveBuffer;

    dec(xpos,2);
    inc(ypos,1);
    pos:=(pos+1) MOD NUMBER_ANIMS;

{$IFDEF DEBUG}
    SetRGB(0,0,0,0);
    while KeyHit[26] do ; {Hit 'P' to pause in debug mode}
{$ENDIF}
end;


begin
    SetScreenMode(MODE320x200x16);
    Screen_Off;
    InitDemo;
    Screen_On;
    SetAllInterrupts;
    repeat RunOnce until Key='e'; {press ESCape key to exit}
    RestoreAllInterrupts;
    UninitDemo;
    SetScreenMode(TEXTMODE);
end.